Questionnaire Preparations: Cognitive Control and Motivated Reasoning

Data cleaning, data checks, scale caluclations, and some further preparations for analyses specific of the questionnaire data.
# use groundhog to make code maximally reproducible
if (!require("groundhog", quietly = TRUE)) {
  install.packages("groundhog")
}
library("groundhog")

# use groundhog to install and load packages
pkgs <- c("here",         # System path management
          "tidyverse",    # ggplot, dplyr, %>%, and friends
          "tinytable",    # Lightweight package to create tables
          "modelsummary", # Data and model summaries with tables and plots
          "pandoc",       # Required for saving tables as docx
          "MBESS",        # Mix of functions including reliability
          "hrbrthemes",   # Additional ggplot themes
          "extrafont",    # Additional fonts for plots etc
          "showtext",     # So that fonts also work on mac
          "patchwork",    # Combine ggplot objects
          "corrplot",     # Correlation plots
          "lavaan"        # Required for reliability calculation
          )

groundhog.library(pkgs, "2024-07-01") 

Data Preparations

Add the same subj_idx as from the gng_task to the raw data.

data_id <- data_raw %>%
  left_join(id_table, by = "Participant Private ID")

# check if it worked
id_check <- data_id %>%
  select(`Participant Private ID`, subj_idx) %>%
  distinct() 

head(id_check)
# A tibble: 6 × 2
  `Participant Private ID` subj_idx
                     <dbl>    <dbl>
1                 11693545      252
2                 11693585        1
3                 11693590      382
4                 11693627      253
5                 11693677        2
6                 11693710      255

Convert data types

# Define the levels
items_levels_order <- c("Strongly disagree", "Disagree", "Neutral", "Agree", "Strongly agree")

data_converted <- data_id %>% 
  mutate(across(
    .cols = c(o_immigration:dog11), 
    .fns = ~ str_replace_all(.x, "Strongly Agree", "Strongly agree") %>%
             factor(levels = items_levels_order, ordered = TRUE)
  ))
# Define the levels
ideo_levels_order <- c("Extremely left", "Left", "Slightly left", 
                       "Moderate",
                       "Slightly right", "Right", "Extremely right")

gender_order <- c("female", "male", "__other")

data_converted <- data_converted %>% 
  mutate(ideology = factor(ideology, levels = ideo_levels_order, ordered = TRUE),
         gender = factor(gender, levels = gender_order, ordered = FALSE)) %>% 
  mutate(gender = fct_recode(gender, "other" = "__other"))
data_converted <- data_converted %>% 
  mutate(
    ideology_num = case_when(
      ideology == "Extremely left" ~ 1,
      ideology == "Left" ~ 2,
      ideology == "Slightly left" ~ 3,
      ideology == "Moderate" ~ 4,
      ideology == "Slightly right" ~ 5,
      ideology == "Right" ~ 6,
      ideology == "Extremely right" ~ 7,
      TRUE ~ NA_real_  
    )) 

Calculate variables

Education ISCED Level
  • ISCED 0-2 is anything up to GCSE

  • ISCED 3-4 is anything up to A-levels

  • ISCED 5-8 is anything in higher education (BSc, MSc, Doctoral degree and so on)

data_scores <- data_converted %>%
  mutate(edu_group = case_when(
    education %in% c("Primary school", "Secondary school up to 16 years (GCSEs or equivalent)") ~ "ISCED 0-2",
    education == "Higher secondary or further education (A-levels, T-levels, BTEC, International Baccalaureate or equivalent)" ~ "ISCED 3-4",
    education %in% c("Bachelors degree (BA, BSc., BEd., BEng.)", 
                     "Masters Degree, M.Phil, Post-Graduate Diplomas and Certificates", 
                     "Ph.D, D.Phil or equivalent") ~ "ISCED 5-8",
    education %in% c("__other") ~ "Other",
    TRUE ~ "Other"
  ))  %>%
  mutate(edu_group = factor(edu_group, levels = c("ISCED 0-2", "ISCED 3-4", "ISCED 5-8", "Other"), ordered = FALSE))
Age group
data_scores <- data_scores %>%
  mutate(age_group = case_when(
    age_corrected >= 18 & age_corrected <= 24 ~ "18-24",
    age_corrected >= 25 & age_corrected <= 31 ~ "25-31",
    age_corrected >= 32 ~ "Above 32",
    TRUE ~ "Other"
    ),
    age_group = factor(age_group, levels = c("18-24", "25-31", "Above 32", "Other"), ordered = FALSE)
  )
Attention check

Participants passed the attention check when they selected “Strongly agree”.

data_scores <- data_scores %>% 
  mutate(questionnaire_attention_check = 
           case_when(attention_check == "Strongly agree" ~ "passed",
                     attention_check != "Strongly agree" ~ "failed"))
Score of Cognitive Reflection Test
  • crt1 correct answer is 4 years

  • crt2 correct answer is 10 seconds

  • crt3 correct answer is 39 days

correct_answers <- list(crt1 = 4, crt2 = 10, crt3 = 39)

data_scores <- data_scores %>% 
  rowwise() %>%
  mutate(
    crt_correct = sum(
      crt1 == correct_answers$crt1,
      crt2 == correct_answers$crt2,
      crt3 == correct_answers$crt3
    )
  ) %>%
  ungroup()
Sum score of Dogmatism Scale

Transform items to numeric

data_numeric <- data_scores %>%
  mutate(across(
    .cols = c(dog01, dog02, dog03, dog04, dog05,  
              dog06, dog07, dog08, dog09, 
              dog10, dog11),
    .fns = as.numeric
  ))

Recode items dog02, dog04, dog05, dog07, dog08, dog09

# Reverse code relevant dog items
data_numeric <- data_numeric %>%
  mutate(
    dog02_r = 6 - dog02,
    dog04_r = 6 - dog04,
    dog05_r = 6 - dog05,
    dog07_r = 6 - dog07,
    dog08_r = 6 - dog08,
    dog09_r = 6 - dog09
  )

Calculate the sum score

data_scores <- data_numeric %>%
  rowwise() %>%
  mutate(dogmatism = sum(c_across(c(dog01, dog02_r, dog03, dog04_r, 
                                    dog05_r, dog06, dog07_r, dog08_r,
                                    dog09_r, dog10, dog11)), 
                         na.rm = TRUE)) %>%
  ungroup()

Calculate the reliability of the dogmatism scale

data_numeric %>% 
  select(dog01, dog02_r, dog03, dog04_r, dog05_r, 
         dog06, dog07_r, dog08_r, dog09_r, dog10, dog11) %>% 
  ci.reliability(., conf.level = 0.95, interval.type = 'mlr')
$est
[1] 0.811

$se
[1] 0.0167

$ci.lower
[1] 0.778

$ci.upper
[1] 0.843

$conf.level
[1] 0.95

$type
[1] "omega"

$interval.type
[1] "robust maximum likelihood (wald ci)"
Affective polarisation

Create a long df

data_polarisation_long <- data_numeric %>% 
  select(subj_idx, conservative_rating, labour_rating, libdem_rating, 
         green_rating, reform_rating) %>% 
  pivot_longer(
    cols = -subj_idx,                  
    names_to = "party",                
    values_to = "rating"               
  ) %>% 
  mutate(
    party = str_replace(party, "_rating", "")  # Remove "_rating" suffix
  )

Calculate affective polarisation as the spread of ratings (see https://www.sciencedirect.com/science/article/pii/S0261379420300822)

data_polarisation <- data_polarisation_long %>%
  group_by(subj_idx) %>% 
  # calculate mean of all party ratings for each subject
  mutate(
    M_rating = mean(rating, na.rm = TRUE), 
    # calculate squared difference from the mean rating for each party
    ExpDiff_rating = (rating - M_rating)^2
  ) %>% 
  reframe(
    n_valid_ratings = sum(!is.na(rating)),
    # calculate spread of ratings (affective polarization)
    affective_polarisation = ifelse(n_valid_ratings >= 2, sqrt(mean(ExpDiff_rating, na.rm = TRUE)), NA)
  ) %>%
  ungroup() %>% 
  select(subj_idx, affective_polarisation)

data_polarisation
# A tibble: 504 × 2
   subj_idx affective_polarisation
      <dbl>                  <dbl>
 1        1                   43.8
 2        2                   29.9
 3        3                   37.0
 4        4                   26.5
 5        5                   22.3
 6        6                   34.9
 7        7                   31.7
 8        8                   35.1
 9        9                   27.7
10       10                   30.4
# ℹ 494 more rows

Add it back to the data

data_scores <- data_scores %>% 
  left_join(data_polarisation, by = "subj_idx")

Code motives from issue opinion items

The motives correspond to the ones in the Fake News Game.

There are some questions that correspond to a Pro-Motive if the message in the Fake News Game is higher, and some questions that correspond to a Anti-Motive if the message in the Fake News Game is higher.

If Message in Fake News Game is Higher, then Agree / Strongly Agree on the following questions corresponds to a Higher-Motive:

  • o_climate

  • o_immigration

  • o_punishment

  • o_teaculture

  • o_brain

In other words, for these questions, the values “Agree” and “Strongly Agree” should be coded as “Higher” for the variable “motive”. And the values “Disagree” and “Strongly disagree” should be coded as “Lower”. The value “Neutral” should stay as “Neutral”.

If Message in Fake News Game is Higher, then Agree / Strongly Agree on the following questions corresponds to a Lower-Motive:

  • o_gender

  • o_discrimination

  • o_adoption

  • o_selfenhancement

  • o_cats

In other words, for these questions, the values “Agree” and “Strongly agree” should be coded as “Lower” for the variable “motive”. And the values “Disagree” and “Strongly disagree” should be coded as “Higher”. The value “Neutral” should stay as “Neutral”.

I want to store these motives in variables called m_[topic]

In addition, I would like to calculate the strength of motives. Disagree and Agree are strength 1, and Strongly disagree and Strongly agree are strength 2.

I want to store the strength of each motive in variables called s_[topic]

# Define the questions corresponding to Higher and Lower motives
higher_motive_questions <- c("o_climate", "o_immigration", "o_punishment", "o_teaculture", "o_brain")
lower_motive_questions <- c("o_gender", "o_discrimination", "o_adoption", "o_selfenhancement", "o_cats")

# Function to recode motives
recode_motive <- function(x, higher = TRUE) {
  case_when(
    x %in% c("Agree", "Strongly agree") & higher ~ "Higher",
    x %in% c("Disagree", "Strongly disagree") & higher ~ "Lower",
    x %in% c("Agree", "Strongly agree") & !higher ~ "Lower",
    x %in% c("Disagree", "Strongly disagree") & !higher ~ "Higher",
    x == "Neutral" ~ "Neutral",
    TRUE ~ NA_character_  
  )
}

# Function to calculate motive strength
calculate_strength <- function(x) {
  case_when(
    x %in% c("Strongly disagree", "Strongly agree") ~ 2,
    x %in% c("Disagree", "Agree") ~ 1,
    x == "Neutral" ~ NA_integer_,
    TRUE ~ NA_integer_  
  )
}

# Recode motives and calculate strengths
data_motives <- data_scores %>%
  mutate(
    across(all_of(higher_motive_questions), ~ recode_motive(.x, higher = TRUE), .names = "m_{gsub('o_', '', col)}"),
    across(all_of(lower_motive_questions), ~ recode_motive(.x, higher = FALSE), .names = "m_{gsub('o_', '', col)}"),
    across(all_of(higher_motive_questions), ~ calculate_strength(.x), .names = "s_{gsub('o_', '', col)}"),
    across(all_of(lower_motive_questions), ~ calculate_strength(.x), .names = "s_{gsub('o_', '', col)}")
  )

Code motives from ideology

Ideology item: In politics, people often talk of “Left” and “Right”. Where would you place yourself on the following scale?

  1. Extremely left - 7. Extremely right

I created a new variable called “ideo_group” that codes

  • Extremely left, Left and Slightly left: Left

  • Extremely right, Right, and Slightly right: Right

  • Moderate: Moderate

I also code the strength from 0 (Moderate) to 3 (Extreme)

The goal is now to create a variable for each issue that codes the ideology motive. As motives on non-political issues cannot be inferred using the ideology variable, I use arbitrary values for this.

if ideo_group “Left” then this variable should take the values:

  • climate: “Higher”

  • adoption: “Lower”

  • punishment: “Lower”

  • gender: “Higher”

  • discrimination: “Lower”

  • immigration: “Lower”

  • Random placeholders for non-political

    • teaculture: “Lower”

    • brain: “Lower”

    • cats: “Lower”

if ideo_group “Right” then this variable should take the values:

  • climate: “Lower”

  • adoption: “Higher”

  • punishment: “Higher”

  • gender: “Lower”

  • discrimination: “Higher”

  • immigration: “Higher”

  • Random placeholders for non-political

    • teaculture: “Higher”

    • brain: “Higher”

    • cats: “Higher”

If ideo_group == “Moderate” then this variable should take the values:

  • “Neutral”
# Collapse ideology into groups
data_motives <- data_motives %>%
  mutate(
    ideo_group = case_when(
      ideology %in% c("Extremely left", "Left", "Slightly left") ~ "Left",
      ideology %in% c("Extremely right", "Right", "Slightly right") ~ "Right",
      ideology == "Moderate" ~ "Moderate"
    )
  )

# Create ideo_strength variable
data_motives <- data_motives %>%
  mutate(
    ideo_strength = case_when(
      ideology %in% c("Slightly left", "Slightly right") ~ 1,
      ideology %in% c("Left", "Right") ~ 2,
      ideology %in% c("Extremely left", "Extremely right") ~ 3,
      ideology == "Moderate" ~ NA_integer_ 
    )
  )

# Create ideo_m_topic variables
data_motives <- data_motives %>%
  mutate(
    ideo_m_climate = case_when(
      ideo_group == "Left" ~ "Higher",
      ideo_group == "Right" ~ "Lower",
      ideo_group == "Moderate" ~ "Neutral"
    ),
    ideo_m_adoption = case_when(
      ideo_group == "Left" ~ "Lower",
      ideo_group == "Right" ~ "Higher",
      ideo_group == "Moderate" ~ "Neutral"
    ),
    ideo_m_punishment = case_when(
      ideo_group == "Left" ~ "Lower",
      ideo_group == "Right" ~ "Higher",
      ideo_group == "Moderate" ~ "Neutral"
    ),
    ideo_m_gender = case_when(
      ideo_group == "Left" ~ "Higher",
      ideo_group == "Right" ~ "Lower",
      ideo_group == "Moderate" ~ "Neutral"
    ),
    ideo_m_discrimination = case_when(
      ideo_group == "Left" ~ "Lower",
      ideo_group == "Right" ~ "Higher",
      ideo_group == "Moderate" ~ "Neutral"
    ),
    ideo_m_immigration = case_when(
      ideo_group == "Left" ~ "Lower",
      ideo_group == "Right" ~ "Higher",
      ideo_group == "Moderate" ~ "Neutral"
    ),
    ideo_m_teaculture = case_when(
      ideo_group == "Left" ~ "Lower",
      ideo_group == "Right" ~ "Higher",
      ideo_group == "Moderate" ~ "Neutral"
    ),
    ideo_m_brain = case_when(
      ideo_group == "Left" ~ "Lower",
      ideo_group == "Right" ~ "Higher",
      ideo_group == "Moderate" ~ "Neutral"
    ),
    ideo_m_cats = case_when(
      ideo_group == "Left" ~ "Lower",
      ideo_group == "Right" ~ "Higher",
      ideo_group == "Moderate" ~ "Neutral"
    ),
  )

Code performance default motive

The default motive for performance questions is “Higher” (due to self-enhancement bias).

data_motives <- data_motives %>% 
  mutate(self_m_enhancement = "Higher")

Data checks

General descriptive checks

Demographics

data_motives %>% 
  select(gender, age_group, worksit, education, edu_group, 
         ideology, partisanship, crt_correct, attention_check, attention_start, attention_end) %>% 
  mutate(across(everything(), as.factor)) %>% 
  datasummary_skim(type = "categorical")
tinytable_f968o2hresjofnwlpjek
N %
gender female 215 42.7
male 284 56.3
other 5 1.0
age_group 18-24 167 33.1
25-31 168 33.3
Above 32 169 33.5
Other 0 0.0
worksit __other 5 1.0
At university 93 18.5
Employed 309 61.3
In school 4 0.8
Self-employed 37 7.3
Unemployed 46 9.1
Working in the household 10 2.0
education __other 2 0.4
Bachelors degree (BA, BSc., BEd., BEng.) 210 41.7
Higher secondary or further education (A-levels, T-levels, BTEC, International Baccalaureate or equivalent) 173 34.3
Masters Degree, M.Phil, Post-Graduate Diplomas and Certificates 72 14.3
Ph.D, D.Phil or equivalent 4 0.8
Primary school 1 0.2
Secondary school up to 16 years (GCSEs or equivalent) 42 8.3
edu_group ISCED 0-2 43 8.5
ISCED 3-4 173 34.3
ISCED 5-8 286 56.7
Other 2 0.4
ideology Extremely left 23 4.6
Left 159 31.5
Slightly left 83 16.5
Moderate 23 4.6
Slightly right 110 21.8
Right 91 18.1
Extremely right 15 3.0
partisanship __other 25 5.0
Conservative 104 20.6
Green 64 12.7
Labour 150 29.8
Liberal Democrat 44 8.7
Plaid Cymru 5 1.0
Reform UK 96 19.0
SNP 16 3.2
crt_correct 0 123 24.4
1 97 19.2
2 120 23.8
3 164 32.5
attention_check Strongly disagree 0 0.0
Disagree 0 0.0
Neutral 0 0.0
Agree 0 0.0
Strongly agree 504 100.0
attention_start No 1 0.2
Yes 503 99.8
attention_end No 6 1.2
Yes 496 98.4
# save it
data_motives %>% 
  select(gender, age_group, worksit, education, edu_group, 
         ideology, partisanship, crt_correct, attention_check, attention_start, attention_end) %>% 
  mutate(across(everything(), as.factor)) %>% 
  datasummary_skim(type = "categorical") %>% 
  save_tt(here("03_output", "tables", "questionnaire_factors_check.docx"), overwrite = TRUE)

Some participants reported not having been attentive. Let’s check which they are:

data_motives %>% 
  filter(attention_start != "Yes" | attention_end != "Yes") %>% 
  select(subj_idx, `Participant Private ID`, age_corrected, ideology, 
         attention_start, attention_end) %>% 
  tt()
tinytable_lt9w6on1z7dggfvo2d88
subj_idx Participant Private ID age_corrected ideology attention_start attention_end
40 11694553 33 Left Yes No
391 11694948 20 Right Yes No
237 11706788 23 Moderate Yes No
240 11707860 22 Slightly right Yes No
365 11694595 29 Left Yes No
32 11694531 33 Left No Yes
22 11694456 27 Left Yes No

Continuous variables

data_motives %>% 
  select(age_corrected, conservative_rating:reform_rating, 
         crt_correct, dogmatism, affective_polarisation) %>% 
  datasummary_skim(type = "numeric") 
tinytable_0cuyooeaniywogba4cvk
Unique Missing Pct. Mean SD Min Median Max Histogram
age_corrected 24 0 28.1 6.1 18.0 28.0 51.0
conservative_rating 91 0 29.5 28.7 0.0 20.0 100.0
labour_rating 97 0 44.2 29.2 0.0 48.0 100.0
libdem_rating 92 0 42.4 24.7 0.0 44.0 100.0
green_rating 95 0 49.2 29.2 0.0 50.0 100.0
reform_rating 86 0 29.8 33.4 0.0 12.0 100.0
crt_correct 4 0 1.6 1.2 0.0 2.0 3.0
dogmatism 32 0 23.0 5.4 11.0 23.0 49.0
affective_polarisation 479 0 26.5 9.0 0.0 27.5 46.4
# save it
data_motives %>% 
  select(age_corrected, conservative_rating:reform_rating, 
         crt_correct, dogmatism, affective_polarisation) %>% 
  datasummary_skim(fun_numeric = list(Mean = Mean, 
                                      SD = SD, Min = Min, 
                                      Median = Median, 
                                      Max = Max
                                      )) %>% 
  save_tt(here("03_output", "tables", "questionnaire_continuous_check.docx"), overwrite = TRUE)

Issue motive variables

data_motives %>% 
  select(m_climate:s_cats) %>% 
  datasummary_skim(type = "categorical")
tinytable_bz786v46cohaofy0leoz
N %
m_climate Higher 407 80.8
Lower 28 5.6
Neutral 69 13.7
m_immigration Higher 204 40.5
Lower 205 40.7
Neutral 95 18.8
m_punishment Higher 262 52.0
Lower 164 32.5
Neutral 78 15.5
m_teaculture Higher 358 71.0
Lower 28 5.6
Neutral 118 23.4
m_brain Higher 329 65.3
Lower 21 4.2
Neutral 154 30.6
m_gender Higher 360 71.4
Lower 78 15.5
Neutral 66 13.1
m_discrimination Higher 83 16.5
Lower 366 72.6
Neutral 55 10.9
m_adoption Higher 102 20.2
Lower 335 66.5
Neutral 67 13.3
m_selfenhancement Higher 233 46.2
Lower 144 28.6
Neutral 127 25.2
m_cats Higher 111 22.0
Lower 294 58.3
Neutral 99 19.6

Ideology motive variables

data_motives %>% 
  select(ideo_strength:ideo_m_immigration) %>% 
  datasummary_skim(type = "categorical")
tinytable_z5n85bgy51l2vevbgx67
N %
ideo_m_climate Higher 265 52.6
Lower 216 42.9
Neutral 23 4.6
ideo_m_adoption Higher 216 42.9
Lower 265 52.6
Neutral 23 4.6
ideo_m_punishment Higher 216 42.9
Lower 265 52.6
Neutral 23 4.6
ideo_m_gender Higher 265 52.6
Lower 216 42.9
Neutral 23 4.6
ideo_m_discrimination Higher 216 42.9
Lower 265 52.6
Neutral 23 4.6
ideo_m_immigration Higher 216 42.9
Lower 265 52.6
Neutral 23 4.6
Correlations
# select and rename data
corr_data <- data_motives %>% 
  mutate(across(
    .cols = c(gender, edu_group, ideology, o_immigration:o_brain, o_discrimination:o_gender),  
    .fns = ~ as.numeric(.x)  # Conversion to numeric
  )) %>% 
  select(age_corrected, gender, edu_group, ideology, conservative_rating:reform_rating,
         o_immigration:o_brain, o_discrimination:o_gender, crt_correct, 
         dogmatism, affective_polarisation)

# correlation analysis
corrs <- cor(corr_data)
corrs_p <- cor.mtest(corr_data, conf.level = 0.95)

# plot it 
col <- colorRampPalette(c("#4477AA", "#77AADD", "#FFFFFF", "#EE9988", "#BB4444"))
corrplot(corrs, method="color", col=col(200),  
         type="upper", order="original", 
         addCoef.col = "black", # Add coefficient of correlation
         tl.col="black", tl.srt=45, # Text label color and rotation,
         #p.mat = corrs_p$p, sig.level = 0.05, insig = "blank", 
         diag=FALSE, number.cex=0.85 
         )

# save it
png(filename = here("03_output", "figures", "questionnaire_correlation_plot.png"), width = 12, height = 12, units = "in", res = 300)

corrplot(corrs, method="color", col=col(200),  
         type="upper", order="original", 
         addCoef.col = "black", # Add coefficient of correlation
         tl.col="black", tl.srt=45, # Text label color and rotation,
         #p.mat = corrs_p$p, sig.level = 0.05, insig = "blank", 
         diag=FALSE, number.cex=0.85 
         )

dev.off()
quartz_off_screen 
                2 

Save data frames

I will save two data frames. One includes all variables that are in data_motives, including all individual items. The other data frame only includes the items that I need for further analyses.

data_sel <- data_motives %>% 
  select(subj_idx, `Participant Private ID`, 
         age_corrected, age_group, gender, worksit, education, edu_group, 
         ideology, ideology_num, partisanship, conservative_rating:reform_rating, 
         questionnaire_attention_check, attention_start, attention_end, 
         crt_correct, dogmatism:self_m_enhancement)
# selected data
write_csv(data_sel, here("01_data", "scored", 
                         "data_questionnaire_scores_sel.csv"), 
          na = "", append = FALSE, col_names = TRUE)

# full data
write_csv(data_motives, here("01_data", "scored", 
                             "data_questionnaire_scores_all.csv"), 
          na = "", append = FALSE, col_names = TRUE)